#lang racket


(require "../constructors-cache.rkt"
         "../math.rkt"
         "../point.rkt"
         "../point-matrix.rkt")

(require "domain.rkt"
         "parametric-curve.rkt")


(provide (struct-out unsupported)
         (struct-out segment)
         
         t-strategy-min
         t-strategy-half
         t-strategy-max
         
         segment-object
         segment-tangent
         segment-normal
         segment-binormal
         segment-cs)


(define-struct (unsupported exn:fail:unsupported) ())

(define-struct segment
  (parametric domain))


(define (t-strategy-min)
  (λ (domain)
    (when (eq? (domain-min-s domain) 'open)
      (raise unsupported "Min strategy is not applicable to a domain with an open lower bound"))
    (domain-min-val domain)))

(define (t-strategy-half)
  (λ (domain)
    (let ((a (domain-min-val domain))
          (b (domain-max-val domain)))
      (/2 (+ a b)))))

(define (t-strategy-max)
  (λ (domain)
    (when (eq? (domain-max-s domain) 'open)
      (raise unsupported "Max strategy is not applicable to a domain with an open upper bound"))
    (domain-max-val domain)))


(define (segment-space segment space t-strategy point?)
  (let ((t (t-strategy (segment-domain segment)))
        (parametric (segment-parametric segment)))
    (m*p
     (parametric-curve-transformation parametric)
     ((space parametric) t)
     point?)))

(define (segment-object segment (t-strategy (t-strategy-min)))
  (segment-space segment parametric-curve-object t-strategy #t))

(define (segment-tangent segment (t-strategy (t-strategy-min)))
  (segment-space segment parametric-curve-tangent t-strategy #f))

(define (segment-normal segment (t-strategy (t-strategy-min)))
  (segment-space segment parametric-curve-normal t-strategy #f))

(define (segment-binormal segment (t-strategy (t-strategy-min)))
  (segment-space segment parametric-curve-binormal t-strategy #f))

(define (segment-cs segment node (t-strategy (t-strategy-min)))
  (define (move-and-rotate)
    (move
     (segment-object segment t-strategy)
     (rotate 
      (p<\p 
       ux
       (segment-normal segment t-strategy)
       (segment-binormal segment t-strategy))
      (segment-binormal segment t-strategy)
      node)))
  
  (define (move-no-rotate)
    (move (segment-object segment t-strategy) node))
  
  (with-handlers
      ((unsupported? (λ (e) (move-no-rotate))))
    (move-and-rotate)))